home *** CD-ROM | disk | FTP | other *** search
/ Network Support Library / RoseWare - Network Support Library.iso / manage / bconfg.arc / BCONFIG.PAS < prev    next >
Pascal/Delphi Source File  |  1989-11-17  |  29KB  |  796 lines
  1.  Program BConfig; {version 1.2}
  2.  
  3.  {.$Define Quiet}
  4.  {.$Define UseSysReq}       {remove the dot to make Sys Req the hotkey}
  5.  
  6.  uses TPCRT,                {Turbo Professional Routines}
  7.       TPDOS,                {  "         "          "   }
  8.       TPEnhKbd,             {  "         "          "   }
  9.       TPString,             {  "         "          "   }
  10.       TPWindow;             {  "         "          "   }
  11.  
  12.  Type
  13.    Str80 = String[80];
  14.    StrikeMode = (Single,Double,Animate);
  15.    SmallArray = Array[1..255] of byte;
  16.  
  17.  Const
  18.    TopRow  : byte = 3;
  19.    LeftCol : byte = 55;
  20.    Factor : Word = ($ffff div 99);             {conversion factor for speed}
  21.    SysString : String[22] =   '<Sys Req> to activate$';
  22.    NoSysString : String[22] = '<Ctrl+Alt+Left Shift> ';
  23.    Arrows : String[4] = ^[^Z'  ';
  24.    OldMenu : Array[1..9] of string[21]= (
  25.  
  26.            '       Wake up       ',
  27.            '   Window position   ',
  28.            '     Window size     ',
  29.            '    Double Strike    ',
  30.            '    Unhook BDEBUG    ',
  31.            ' Exit this menu (ESC)',
  32.            '═════════════════════',
  33.            ' move   pgup pgdn  ',
  34.            ' with   home end ctr ');
  35.  
  36.    Menu : Array[1..20] of String[23] =
  37.           ('┌─────────────────────┐',
  38.            '│     BConfig 1.2     │',
  39.            '│BDEBUG config utility│',
  40.            '│ copyright (C) 1989  │',
  41.            '│     Jeff Bowles     │',
  42.            '├─────────────────────┤',
  43.            '│                     │',
  44.            '│    Menu position    │',
  45.            '│   Window position   │',
  46.            '│     Window size     │',
  47.            '│                     │',
  48.            '│     Clone BDEBUG    │',
  49.            '│      Menu Color     │',
  50.            '│ Selection Bar Color │',
  51.            '│     Window Color    │',
  52.            '│ Exit this menu (ESC)│',
  53.            '├─────────────────────┤',
  54.            '│  Use  to move bar. │',
  55.            '│                     │',
  56.            '└─────────────────────┘');
  57.  
  58.    Bwindow : Array[1..22] of string[80] =
  59.              ('Operation    -: BConfig 1.2         ┌Key Value─┬─────────────────────────────┐',
  60.               '             -:BDEBUG config        │..........│.............................│',
  61.               'Record Length-:(C) J. Bowles        │..........│.............................│',
  62.               'Key No.      -:                     │..........│.............................│',
  63.               'Key Length   -: move with           │..........│.............................│',
  64.               '             -: pgup pgdn         │..........│.............................│',
  65.               'Status       -: home end ctr        │..........│.............................│',
  66.               '             -:                     │..........│.............................│',
  67.               '  Hit Any Key To Continue           └──────────┴─────────────────────────────┘',
  68.               '┌Record Buffer Value┬────────────────────────────────────────────────────────┐',
  69.               '│...................│........................................................│',
  70.               '│...................│........................................................│',
  71.               '│...................│........................................................│',
  72.               '│...................│........................................................│',
  73.               '│...................│........................................................│',
  74.               '│...................│........................................................│',
  75.               '│...................│........................................................│',
  76.               '│...................│........................................................│',
  77.               '│...................│........................................................│',
  78.               '│...................│........................................................│',
  79.               '│...................│........................................................│',
  80.               '└───────────────────┴────────────────────────────────────────────────────────┘');
  81.  
  82.    BPatch : Array[1..40] of byte =
  83.                   ($53,$51,$52,$57,$56,$1e,$06,       {PUSH several regs      }
  84.                    $bb,$01,$00,                       {mov bx,speedword       }
  85.                    $b4,$01,                           {mov ah,01              }
  86.                    $cd,$16,                           {int 16h, scan keyboard }
  87.                    $75,$0e,                           {jnz , if key pressed   }
  88.                    $4b,                               {dec bx                 }
  89.                    $75,$f7,                           {jnz , loop if not zero }
  90.                    {gohome}
  91.                    $07,$1f,$5e,$5f,$5a,$59,$5b,       {POP all PUSHed regs    }
  92.                    $e9,$90,$27,                       {jmp 380Ch, go BDEBUG   }
  93.                    $90,                               {NOP                    }
  94.                    $b4,$00,                           {mov ah,0               }
  95.                    $cd,$16,                           {int 16h,  flush keybd  }
  96.                    $b4,$00,                           {mov ah,0               }
  97.                    $cd,$16,                           {int 16h, wait for key  }
  98.                    $eb,$eb);                          {jmp gohome, go BDEBUG  }
  99.  
  100.   {$IfDef UseSysReq}
  101.   SysPatch : Array[1..18] of byte = (
  102.         $1E,                   {push ds}
  103.         $50,                   {push ax}
  104.         $31,$C0,               {xor ax,ax}
  105.         $8E,$D8,               {mov ds,ax}
  106.         $A0,$18,$04,           {mov al,[$0418]}
  107.         $24,$04,               {and al,$04}
  108.         $3C,$04,               {cmp al,$04}
  109.         $58,                   {pop ax}
  110.         $1F,                   {pop ds}
  111.         $E9,$D1,$2A);          {jmp $3B6A}
  112.  
  113.    GoSysPatch : Array[1..4] of byte = ($e9,$22,$d5,        {jmp $0f87   }
  114.                                        $90);               {NOP         }
  115.    {$EndIf}
  116.  
  117.    NoSysPatch : Array[1..4] of byte = ($b4,$02,            {mov ah,02   }
  118.                                        $cd,$16);           {int 16h     }
  119.  
  120.    AnimatePatch : Array[1..4] of byte = ($e9,$53,$d8,      {jmp 0F5Fh   }
  121.                                          $90);             {NOP         }
  122.  
  123.    NormalPatch  : Array[1..4] of byte = ($b4,$00,          {mov ah,0    }
  124.                                          $cd,$16);         {int 16h     }
  125.  
  126.  
  127.  
  128.    Sel : integer = 0;
  129.  
  130.  var
  131.    CloneFile        : File of Byte;
  132.    StrkMode         : StrikeMode;
  133.    Wake,WasIn8x8    : Boolean;
  134.  
  135.    AnimateFactor,                              {00-99, translates to 0-$FFFF }
  136.    WPosX,WPosY,
  137.    MPosX,MPosY,
  138.    WHeight,WWidth,
  139.    MHeight,MWidth,
  140.    MenuColor, HiColor,
  141.    WindowColor      : Byte;
  142.    MenuBufPtr       : WindowPtr;
  143.    BufPtr           : WindowPtr;               {used in TPWindow routines    }
  144.    Scr              : Pointer;                 {used to save original screen }
  145.    Ch,XY,ScanLines  : Word;                    {used to save original cursor }
  146.    FullName         : String;
  147.  
  148.  Procedure SoundBlip(HZ : Integer);
  149.  Begin
  150.    {$IfNDef Quiet}
  151.      sound(HZ);
  152.      delay(50);
  153.      nosound;
  154.    {$EndIf}
  155.  End;
  156.  
  157.  Procedure MaybeBlip(CH : Word);
  158.  begin
  159.    if  (CH = $011B) or (CH = $1C0D) then
  160.      {}
  161.    else
  162.      SoundBlip(500);
  163.  end;
  164.  
  165.  Procedure ShowToggles;
  166.  Var Temp : String;
  167.  Begin
  168.    if Wake then
  169.      FastWrite('       Wake up       ',TopRow+6,LeftCol+1,MenuColor)
  170.    else
  171.      FastWrite('        Sleep        ',TopRow+6,LeftCol+1,MenuColor);
  172.    Case StrkMode of
  173.      Single: FastWrite('    Single Strike    ',TopRow+10,LeftCol+1,MenuColor);
  174.      Double: FastWrite('    Double Strike    ',TopRow+10,LeftCol+1,MenuColor);
  175.      Animate: begin
  176.                 FastWrite('    Animate     '+arrows,TopRow+10,LeftCol+1,MenuColor);
  177.                 Str(AnimateFactor,Temp);
  178.                 Temp := LeftPadCH(Temp,'0',2);
  179.                 If Sel=4 then
  180.                   FastWrite('A'+Temp,TopRow+10,LeftCol+13,HiColor)
  181.                 else
  182.                   FastWrite('A'+Temp,TopRow+10,LeftCol+13,MenuColor);
  183.               end;
  184.    end;
  185.  End;
  186.  
  187.  Procedure MenuBar (Hilite : boolean);
  188.  Begin
  189.    Case sel of
  190.      0,4 :
  191.        FastWrite(' Hit enter to toggle.',TopRow+18,LeftCol+1,HiColor);
  192.      6,7,8 :
  193.        FastWrite(' F5 ForeGr F6 BackGr.',TopRow+18,LeftCol+1,HiColor);
  194.      else
  195.        FastWrite(' Hit enter to select.',TopRow+18,LeftCol+1,HiColor);
  196.    end;
  197.    if Hilite = True then
  198.      ChangeAttribute(21,TopRow+6+sel,LeftCol+1,HiColor)
  199.    else
  200.      ChangeAttribute(21,TopRow+6+sel,LeftCol+1,MenuColor);
  201.  End;
  202.  
  203.  Procedure ShowWindow;
  204.  var X:integer;
  205.  Begin
  206.  
  207.    if not DisplayWindow(BufPtr) then {};
  208.    HiddenCursor;
  209.    For x := 1 to Wheight-2 do
  210.      FastWriteClip(bwindow[x],x,1,WindowColor);
  211.  End;
  212.  
  213.  Procedure ShowMenuWindow;
  214.  var X:integer;
  215.  Begin
  216.  With WindowP(MenuBufPtr)^ do
  217.    begin
  218.      Draw.FAttr := MenuColor;
  219.      DisplayedOnce := False;
  220.    end;
  221.    if not DisplayWindow(MenuBufPtr) then runerror(99);
  222.    HiddenCursor;
  223.    For x := 1 to Mheight-2 do
  224.      FastWriteClip(OldMenu[x],x,1,MenuColor);
  225.  End;
  226.  
  227.  Procedure ShowMenu(ReadKbd : boolean); forward;
  228.  
  229.  Procedure WindowSize;     {uses TPWindow routines to shrink/grow a window }
  230.  var ch : word;
  231.   Begin
  232.   Ch := 0;
  233.   While not (EraseTopWindow = nil) do;
  234.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  235.   ShowWindow;
  236.   Repeat
  237.     Ch := ReadKeyWord;
  238.     case Ch of
  239.       $4b00 : if WWidth > $1f then                                {left}
  240.                 if ResizeWindow(-1,0,' ') then dec(WWidth);
  241.       $4d00 : if ResizeWindow(1,0,' ') then inc(WWidth);          {right}
  242.       $4800 : if WHeight > $0b then                               {up}
  243.                 If ResizeWindow(0,-1,' ') then Dec(WHeight);
  244.  
  245.       $4700 : if (WHeight > $0b) and (WWidth >$22) then           {home}
  246.                 If ResizeWindow(-3,-1,' ') then begin
  247.                   Dec(WHeight);
  248.                   Dec(WWidth,3);
  249.                 end;
  250.       $4c00 : If MoveWindow(                                      {center 5}
  251.                 ((80-WWidth) div 2)-WPosX,
  252.                 ((24-WHeight) div 2)-WPosY)
  253.                 then begin
  254.                        WPosX := (80-WWidth) div 2;
  255.                        WPosY := (24-WHeight) div 2;
  256.                      end;
  257.       $5000 : if (WHeight+WPosY < 24)  then                       {down}
  258.                 if ResizeWindow(0,1,' ') then Inc(WHeight);
  259.  
  260.       $5100 : if (WHeight+WPosY < 24) and (WWidth < 80) then      {pg down}
  261.                 if ResizeWindow(3,1,' ') then begin
  262.                   Inc(WHeight);
  263.                   Inc(WWidth,3);
  264.                 end;
  265.       else
  266.         MaybeBlip(CH);
  267.     End;
  268.   ShowWindow;
  269.   until (ch = $011b) or (ch = $1c0d) ;                        {esc or enter}
  270.   if (EraseTopWindow=nil) then {};
  271.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  272.   ShowMenu(True);
  273.   ShowToggles;
  274.   End;
  275.  
  276.  Procedure WindowPos;       {Uses TPWindow routines to move a window}
  277.  var ch : word;
  278.  
  279.   Begin
  280.   Ch := 0;
  281.   if not (EraseTopWindow = nil) then {};
  282.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  283.   ShowWindow;
  284.   Repeat
  285.     Ch := ReadKeyWord;
  286.     case Ch of
  287.       $4700 : If MoveWindow(-3,-1) then begin                    {home}
  288.                                           Dec(WPosX,3);
  289.                                           Dec(WPosY);
  290.                                         end;
  291.       $4800 : If MoveWindow(0,-1) then dec(WPosY);               {up}
  292.       $4900 : If MoveWindow(3,-1) then begin                     {pg up}
  293.                                         Inc(WPosX,3);
  294.                                         Dec(WPosY);
  295.                                       End;
  296.       $4b00 : if MoveWindow(-1,0) then dec(WPosX);               {left}
  297.       $4c00 : If MoveWindow(                                     {center 5}
  298.                 ((80-WWidth) div 2)-WPosX,
  299.                 ((24-WHeight) div 2)-WPosY)
  300.                 then begin
  301.                        WPosX := (80-WWidth) div 2;
  302.                        WPosY := (24-WHeight) div 2;
  303.                      end;
  304.       $4d00 : If MoveWindow(1,0) then inc(WPosX);                {right}
  305.       $4f00 : If ((WPosY+WHeight) < 24) and                      {end}
  306.                  MoveWindow(-3,1) then begin
  307.                                          Dec(WPosX,3);
  308.                                          Inc(WPosY);
  309.                                        end;
  310.       $5000 : If (WPosY+Wheight) < 24 then                       {down}
  311.                 If MoveWindow(0,1) then inc(WPosY);
  312.       $5100 : If ((WPosY+WHeight) <24) and                       {pg down}
  313.                  MoveWindow(3,1) then begin
  314.                                         Inc(WPosX,3);
  315.                                         Inc(WPosY);
  316.                                       end;
  317.       else
  318.         MaybeBlip(CH);
  319.     End;
  320.   until (ch = $011b) or (ch = $1c0d) ;                       {esc or enter}
  321.   if (EraseTopWindow=nil) then {};
  322.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  323.   ShowMenu(True);
  324.   ShowToggles;
  325.   End;
  326.  
  327.  Procedure MenuPos;       {Uses TPWindow routines to move a window}
  328.  var ch : word;
  329.   Begin
  330.   Ch := 0;
  331.   if not (EraseTopWindow = nil) then runerror(98);{};
  332.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  333.   ShowMenuWindow;
  334.   Repeat
  335.     Ch := ReadKeyWord;
  336.     case Ch of
  337.       $4700 : If MoveWindow(-3,-1) then begin                    {home}
  338.                                           Dec(MPosX,3);
  339.                                           Dec(MPosY);
  340.                                         end;
  341.       $4800 : If MoveWindow(0,-1) then dec(MPosY);               {up}
  342.       $4900 : If MoveWindow(3,-1) then begin                     {pg up}
  343.                                         Inc(MPosX,3);
  344.                                         Dec(MPosY);
  345.                                       End;
  346.       $4b00 : if MoveWindow(-1,0) then dec(MPosX);               {left}
  347.       $4c00 : If MoveWindow(                                     {center 5}
  348.                 ((80-MWidth) div 2)-MPosX,
  349.                 ((24-MHeight) div 2)-MPosY)
  350.                 then begin
  351.                        MPosX := (80-MWidth) div 2;
  352.                        MPosY := (24-MHeight) div 2;
  353.                      end;
  354.       $4d00 : If MoveWindow(1,0) then inc(MPosX);                {right}
  355.       $4f00 : If ((MPosY+MHeight) < 24) and                      {end}
  356.                  MoveWindow(-3,1) then begin
  357.                                          Dec(MPosX,3);
  358.                                          Inc(MPosY);
  359.                                        end;
  360.       $5000 : If (MPosY+Mheight) < 24 then                       {down}
  361.                 If MoveWindow(0,1) then inc(MPosY);
  362.       $5100 : If ((MPosY+MHeight) <24) and                       {pg down}
  363.                  MoveWindow(3,1) then begin
  364.                                         Inc(MPosX,3);
  365.                                         Inc(MPosY);
  366.                                       end;
  367.       Else
  368.         MaybeBlip(CH);
  369.     End;
  370.   until (ch = $011b) or (ch = $1c0d) ;                       {esc or enter}
  371.   if (EraseTopWindow=nil) then {};
  372.   RestoreWindow(1,1,ScreenWidth,ScreenHeight,False,Scr);
  373.   ShowMenu(True);
  374.   ShowToggles;
  375.   End;
  376.  
  377.  
  378.  
  379.   Procedure HeyYou;
  380.   Begin
  381.     FastWrite(' F5 ForeGr F6 BackGr.',TopRow+18,LeftCol+1,(HiColor or $80));
  382.     SoundBlip(500);
  383.     Delay(1500);
  384.     FastWrite(' F5 ForeGr F6 BackGr.',TopRow+18,LeftCol+1,HiColor);
  385.   End;
  386.  
  387.  Procedure Clone;
  388.  const
  389.    Fname : string = 'BDEBUG.COM';
  390.  var
  391.    temp : byte;
  392.    tempstr : string;
  393.    tempstr2: string;
  394.  
  395.  
  396.    TempWord : Word;
  397.    TempArr  : Array[0..1] of byte absolute TempWord;
  398.  
  399.    Procedure WriteArray(Addr : word; Var A; Elements : byte);
  400.    {local procedure to copy an array to a file at a given offset}
  401.    Var Offset : byte;
  402.    B : array[1..255] of byte absolute A;
  403.    begin
  404.      Seek(CloneFile,Addr);
  405.      For Offset := 1 to Elements do
  406.        Write(CloneFile,B[Offset]);
  407.    end;
  408.  
  409.  Begin
  410.    FastWrite(' *** Now Cloning *** ',TopRow+11,LeftCol+1,MenuColor);
  411.    MenuBar (True);
  412.    SoundBlip(2000);
  413.    Assign(CloneFile,fullname);
  414.    Reset(CloneFile);
  415.  
  416.    {Write animation patch, including user defined speed}
  417.  
  418.    If AnimateFactor = 0 then begin   {speed 0 is really set to 0001 to      }
  419.      BPatch[9]:=1;                   {prevent counter flipping back to $FFFF}
  420.      BPatch[10]:=0;
  421.      end
  422.    else begin
  423.      BPatch[9]:=Lo(AnimateFactor * Factor);   {mult * Factor to scale 99 up}
  424.      BPatch[10]:=Hi(AnimateFactor * Factor);  {to $FFFF, 50 to $8000, etc. }
  425.      end;
  426.    WriteArray($0f5f,BPatch,SizeOf(BPatch));
  427.  
  428.    {Write Position, Size, Mode info}
  429.    Seek(CloneFile,$127f);
  430.    Write(CloneFile,WPosY);
  431.    Write(CloneFile,WPosX);
  432.    Write(CloneFile,WHeight);
  433.    Write(CloneFile,WWidth);
  434.    Temp := ord(StrkMode);
  435.    If Temp = 2 then temp :=0;     {if animate, assume single strike mode}
  436.    Write(CloneFile,Temp);
  437.    Seek(CloneFile,$26d5);
  438.    Temp := ord(Wake);
  439.    Write(cloneFile,Temp);
  440.  
  441.  
  442.    (*********************************************************************)
  443.    {$IfDef UseSysReq}
  444.    WriteArray($0f87,SysPatch,SizeOf(SysPatch));
  445.    WriteArray($3a62,GoSysPatch,SizeOf(GoSysPatch));
  446.    WriteArray($3ee8,SysString[1],Length(SysString));
  447.    {$Else}
  448.    WriteArray($3a62,NoSysPatch,SizeOf(NoSysPatch));
  449.    WriteArray($3ee8,NoSysString[1],Length(NoSysString));
  450.    {$EndIf}
  451.    (*********************************************************************)
  452.  
  453.  
  454.    {Write either 'Jump to Animate' patch or 'Normal' patch  instructions}
  455.    If StrkMode = Animate then
  456.      begin
  457.        WriteArray($3709,AnimatePatch,SizeOf(AnimatePatch));
  458.        TempStr :='A'+LeftPadCh(Long2Str(AnimateFactor),'0',2);
  459.        TempStr2:='Animate ('+LeftPadCh(Long2Str(AnimateFactor),'0',2)+')';
  460.        WriteArray($0174,TempStr [1],Length(TempStr));  {write 'Axx' string}
  461.        WriteArray($018b,TempStr [1],Length(TempStr));  {  "     "      "  }
  462.        WriteArray($01dd,TempStr2[1],Length(TempStr2)); {  "     "      "  }
  463.      end
  464.    else
  465.      begin
  466.        WriteArray($3709,NormalPatch,SizeOf(NormalPatch));
  467.        TempStr := '   ';
  468.        TempStr2:= '            ';
  469.        WriteArray($0174,TempStr[1],Length(TempStr));   {erase 'Axx' string}
  470.        WriteArray($018b,TempStr[1],Length(TempStr));   {erase 'Axx' string}
  471.        WriteArray($01dd,TempStr2[1],Length(TempStr2)); {erase 'Axx' string}
  472.      end;
  473.  
  474.    Seek(clonefile,$3ea2);
  475.    Temp := $fd;
  476.    Write(clonefile,Temp);                              {put the ² in BDEBUG²}
  477.    Seek(CloneFile,$3A18);
  478.    Write(CloneFile,WindowColor);
  479.  
  480.    Seek(CloneFile,$3ADB);
  481.    TempWord := Word(MPosY-1)*80*2 + Word(MPosX-1)*2;
  482.    Write(CloneFile,TempArr[0]);
  483.    Write(CloneFile,TempArr[1]);
  484.    Inc(TempWord,$A2);
  485.    Seek(CloneFile,$3D18);
  486.    Write(CloneFile,TempArr[0]);
  487.    Write(CloneFile,TempArr[1]);
  488.  
  489.    Seek(CloneFile,$3CFB);
  490.    Write(CloneFile,MenuColor);
  491.    Seek(CloneFile,$3D2E);
  492.    Write(CloneFile,HiColor);
  493.    Close(CloneFile);
  494.    SoundBlip(2000);
  495.    FastWrite('     Clone BDEBUG    ',TopRow+11,LeftCol+1,MenuColor);
  496.    MenuBar (True);
  497.  End;
  498.  
  499.  Procedure Select;
  500.  Begin
  501.    Case Sel of
  502.      0 : Begin                    {toggle wake/sleep state}
  503.            Wake := Not(Wake);
  504.            ShowToggles;
  505.            MenuBar (True);
  506.          End;
  507.      1 : MenuPos;
  508.      2 : WindowPos;               {adjust window position}
  509.      3 : WindowSize;              {adjust window size}
  510.      4 : Begin                    {cycle single/double/animate}
  511.            If StrkMode=Animate then
  512.              StrkMode := Single
  513.            Else
  514.              StrkMode := Succ(StrkMode);
  515.            Showtoggles;
  516.            MenuBar (True);
  517.          End;
  518.      5 : Clone;                   {write patches to BDEBUG}
  519.  6,7,8 : HeyYou;                  {Yell at user, use F7-F8 instead}
  520.      9 : Ch := $011b;             {same as ESC, quit}
  521.    End;
  522.  End;
  523.  
  524.  Procedure SetFG( Var Kolor : Byte);
  525.  var f : byte;
  526.  begin
  527.    case CurrentMode of
  528.     2,7 :  begin
  529.              Case Kolor of
  530.                $07,$87 : Inc(Kolor,$69);
  531.                $70,$F0 : Inc(Kolor,$17);
  532.              end;
  533.            end
  534.     else
  535.       begin
  536.         f := (Kolor and $0F);
  537.         inc(f);
  538.         if f > 15 then f:=0;
  539.         Kolor := ((Kolor and $F0) or f);
  540.       end;
  541.     end;
  542.    ShowMenu(False);
  543.  end;
  544.  
  545.  Procedure SetBG( Var Kolor : Byte);
  546.  var B : byte;
  547.  begin
  548.    case CurrentMode of
  549.     2,7 :  begin
  550.              Case Kolor of
  551.                $07,$87 : Inc(Kolor,$69);
  552.                $70,$F0 : Inc(Kolor,$17);
  553.              end;
  554.            end
  555.     else
  556.       begin
  557.         B := Kolor SHR 4;
  558.         inc(B);
  559.         if B > 7 then b := 0;
  560.         Kolor := ((Kolor and $0F) or (B SHL 4));
  561.       end;
  562.     end;
  563.    ShowMenu(False);
  564.  End;
  565.  
  566.  Procedure ShowMenu(ReadKbd : Boolean);
  567.  var x, terminal : byte;
  568.  
  569.  
  570.    {local procedure to display relative animation speed}
  571.    Procedure ShowFactor;
  572.    Var Temp : String;
  573.    Begin
  574.      Str(AnimateFactor,Temp);
  575.      If Length(Temp)<2 then Temp := '0' + Temp;
  576.      FastWrite('A'+Temp,TopRow+10,LeftCol+13,HiColor);
  577.    end;
  578.  
  579.  Begin
  580.    HiddenCursor;
  581.    if ReadKbd then Terminal := 20 else Terminal := 6;
  582.  
  583.    for x:=1 to Terminal do
  584.      begin
  585.        FastWrite(Menu[x],TopRow-1+x,LeftCol,MenuColor);
  586.        If (x>1) and (x<6) then
  587.          ChangeAttribute(21,TopRow-1+x,LeftCol+1,WindowColor);
  588.      end;
  589.    showtoggles;
  590.    MenuBar (True);
  591.    If Not ReadKbd then Exit;
  592.    Ch := 0;
  593.    Repeat
  594.      Ch := ReadKeyWord;
  595.      case Ch of
  596.        $1c0d : Select;                                           {enter}
  597.        $4b00 : if (sel=4) and (StrkMode = Animate) then begin    {left}
  598.                  If AnimateFactor > 0 then
  599.                    Dec(AnimateFactor)
  600.                  else
  601.                    AnimateFactor := 99;
  602.                ShowFactor;
  603.                end;
  604.        $4d00 : if (sel=4) and (StrkMode = Animate) then begin    {right}
  605.                  If AnimateFactor < 99 then
  606.                    Inc(AnimateFactor)
  607.                  else
  608.                    AnimateFactor := 00;
  609.                ShowFactor;
  610.                end;
  611.        $4800 : Begin                                             {up}
  612.                  MenuBar (False);
  613.                  dec(sel);
  614.                  if sel<0 then sel := 9;
  615.                  MenuBar (True);
  616.                End;
  617.        $5000 : Begin                                             {down}
  618.                  MenuBar (False);
  619.                  inc(sel);
  620.                  if sel>9 then sel := 0;
  621.                  MenuBar (True);
  622.                End;
  623.        $3f00 : begin                            {F5 set foreground color}
  624.                  Case Sel of
  625.                  6: Begin
  626.                       SetFG(MenuColor);
  627.                       ShowMenu(True);
  628.                     end;
  629.                  7: Begin
  630.                       SetFG(HiColor);
  631.                       MenuBar(True);
  632.                       With WindowP(BufPtr)^ do
  633.                         begin
  634.                           Draw.HAttr := HiColor;
  635.                           DisplayedOnce := False;
  636.                         end;
  637.                     end;
  638.                  8: Begin
  639.                       SetFG(WindowColor);
  640.                       ShowMenu(False);
  641.                       With WindowP(BufPtr)^ do
  642.                         begin
  643.                           Draw.FAttr := WindowColor;
  644.                           Draw.WAttr :=WindowColor;
  645.                           DisplayedOnce := False;
  646.                         end;
  647.                     End;
  648.                else
  649.              MaybeBlip(CH);
  650.            end;
  651.          end;
  652.        $4000 : begin                             {F6 set background color}
  653.                  Case Sel of
  654.                  6: Begin
  655.                       SetBG(MenuColor);
  656.                       ShowMenu(True);
  657.                     End;
  658.                  7: Begin
  659.                       SetBG(HiColor);
  660.                       MenuBar(True);
  661.                       With WindowP(BufPtr)^ do
  662.                         begin
  663.                           Draw.HAttr := HiColor;
  664.                           DisplayedOnce := False;
  665.                         end;
  666.                     End;
  667.                  8: Begin
  668.                       SetBG(WindowColor);
  669.                       ShowMenu(False);
  670.                       With WindowP(BufPtr)^ do
  671.                         begin
  672.                           Draw.FAttr := WindowColor;
  673.                           Draw.WAttr := WindowColor;
  674.                           DisplayedOnce := False;
  675.                         end;
  676.                     End;
  677.                else
  678.                  MaybeBlip(CH);
  679.            end;
  680.          end
  681.        else
  682.          MaybeBlip(CH);
  683.      End;
  684.    until ch = $011b; {esc}
  685.    NormalCursor;
  686.  End;
  687.  
  688.  Procedure Initialize;
  689.  Begin
  690.    GetCursorState(XY,ScanLines);
  691.    Explode:= true;
  692.    ExplodeDelay := 5;
  693.    {$IfDef Quiet}
  694.      SoundFlagW := False;
  695.    {$EndIf}
  696.    SetFrameChars(#186,#205,#188,#187,#200,#201);
  697.    MWidth:=23;
  698.    MHeight:=11;
  699.  End;
  700.  
  701.  Procedure ReadCloneFile;
  702.  const
  703.    Fname : string = 'BDEBUG.COM';
  704.  var
  705.    temp : byte;
  706.    PosLo : byte;
  707.    PosHi : byte;
  708.    tempword : word;
  709.  Begin
  710.    if Not ExistOnPath(Fname,fullname) then
  711.      Begin
  712.        Writeln('Cannot find ',fname,' on search path.');
  713.        Halt(1);
  714.      End;
  715.    Assign(CloneFile,fullname);
  716.    Reset(CloneFile);
  717.    Seek(CloneFile,$0f5f+8);                 {find speed factor in BDEBUG.COM}
  718.    Read(CloneFile,Temp);                    {read lo byte                   }
  719.    Read(CloneFile,AnimateFactor);           {read hi byte                   }
  720.    AnimateFactor :=
  721.     (AnimateFactor*256 + Temp) Div Factor;  {scale down to 0-99 range       }
  722.    Seek(CloneFile,$127f);
  723.    Read(CloneFile,WPosY);
  724.    Read(CloneFile,WPosX);
  725.    Read(CloneFile,WHeight);
  726.    Read(CloneFile,WWidth);
  727.    Read(CloneFile,Temp);
  728.    If Temp = 0 then
  729.      StrkMode := Single
  730.    else
  731.      StrkMode := Double;
  732.    Seek(CloneFile,$0174);
  733.    Read(CloneFile,temp);                    {look for 'Axx' string         }
  734.    If temp = 65 then
  735.      StrkMode := Animate;                   {found, must be in Animate mode}
  736.    Seek(CloneFile,$26d5);
  737.     Read(CloneFile,Temp);
  738.    Wake := (Temp = 1);                      {convert BDEBUG 0-1 to boolean }
  739.    Seek(CloneFile,$3A18);
  740.    Read(CloneFile,WindowColor);
  741.  
  742.  
  743.    Seek(CloneFile,$3ADB);
  744.    Read(CloneFile,PosLo);
  745.    Read(CloneFile,PosHi);
  746.    TempWord := Word(PosHi)*256+PosLo;
  747.    MPosY := (TempWord div (80*2)) + 1;
  748.    MPosX := ((TempWord - (( MPosY-1) *80*2)) div 2) + 1;
  749.    LeftCol := MPosX;
  750.    Seek(CloneFile,$3CFB);
  751.    Read(CloneFile,MenuColor);
  752.    Seek(CloneFile,$3D2E);
  753.    Read(CloneFile,HiColor);
  754.    Close(CloneFile);
  755.  
  756.    case CurrentMode of
  757.      2,                     {BW80}
  758.      7 :                    {MONOCHROME}
  759.        begin
  760.          WindowColor := $07;      {white on black}
  761.          MenuColor   := $07;      {white on black}
  762.          HiColor     := $70;      {black on white}
  763.        end;
  764.    end;
  765.  End;
  766.  
  767.  Begin {main}
  768.    Initialize;                     {set up defaults, define TPWindow variables}
  769.    ReadCloneFile;                  {load current states from BDEBUG.COM       }
  770.  
  771.    if SaveWindow(1,1,ScreenWidth,ScreenHeight,True,Scr) then
  772.      begin
  773.        If Font8x8Selected then
  774.          begin
  775.            SelectFont8x8(False);
  776.            WasIn8x8 := True;
  777.          end
  778.        else
  779.          WasIn8x8 := False;
  780.  
  781.        If MakeWindow(MenuBufPtr,MPosX,MPosY,MPosX+MWidth-1,
  782.                  MPosY+MHeight-1,True,True,True,MenuColor,
  783.                  MenuColor,HiColor,'Sample Menu') then {};
  784.  
  785.  
  786.        If MakeWindow(BufPtr,WPosX+1,WPosY+1,WPosX+WWidth,
  787.                      WPosY+WHeight,True,True,True,WindowColor,
  788.                      WindowColor,HiColor,' Sample Window ') then  ShowMenu(True);
  789.  
  790.        RestoreWindow(1,1,ScreenWidth,ScreenHeight,True,Scr);
  791.        RestoreCursorState(XY,ScanLines);
  792.        If WasIn8x8 then SelectFont8x8(True);
  793.      end;
  794.  End.
  795.  
  796.